perm filename X.LST[NEW,LCS] blob
sn#148556 filedate 1975-03-04 generic text, type T, neo UTF8
00100 INTERNAL JDRAW ; SUBROUTINE JDRAW(M,R3,CENTR,RSTJ2,RX,RY)
00200 EXTERNAL LL ; COMMON/LL/LL
00300
00400 ; DIMENSION M(1)
00500 JDRAW: 0
00600 MOVE 4,@3(16) ; RC=RX*RSTJ2
00700 MOVE 5,@4(16)
00800 FMPR 5,2 ; 5 HAS RC
00900
01000 MOVE 6,@5(16) ; RD=RY*RSTJ2
01100 FMPR 6,2 ; 6 HAS RD
01200
01300 MOVE 03,M ; DO 2 K=2,M(1)
01400 MOVE 02,0(3)
01500 MOVEM 02,TEMP.
01600 MOVEI 15,2
01700 2M MOVEM 15,K
01800 3M BLOCK 0
01900
02000 MOVE 03,15 ; CALL UNPACK(IA,IB,M(K))
02100 ADD 03,M
02200 MOVEI 02,777777(3)
02300 HRRM 02,4M
02400 JSA 16,UNPACK
02500 JUMP IA
02600 JUMP IB
02700 4M JUMP 4M
02800
02900 2P JSA 16,FLOAT;2 CALL LINES(FLOAT(IA)*RC+R3,FLOAT(IB)*RD+CENTR,LL)
03000 JUMP IA
03100 FMPR RC
03200 FADR R3
03300 MOVEM %TEMP.
03400 JSA 16,FLOAT
03500 JUMP IB
03600 FMPR RD
03700 FADR CENTR
03800 MOVEM %TEMP.+1
03900 JSA 16,LINES
04000 ARG 02,%TEMP.
04100 ARG 02,%TEMP.+1
04300
04400
04500 ARG 00,LL
04600 CAMGE 15,TEMP.
04700 AOJA 15,2M
04800
04900 JRA 16,6(16) ; END
06700
06800
09300
09800 20100 SUBROUTINE CENTER(CNTR)
09900 1M BLOCK 0
10000
10100 20200 C TO CENTER ITEMS CREATED WITH DRAWING PROG.
10200
10300 20300 COMMON /STF/RSTFAC(8),RSTJ2
10400
10500 20400 COMMON R2,JA,CENTR,J2,RJQ(20),JQ(20)
10600
10700 20500 COMMON/POSI/STF(8),JJ2,POS
10800
10900 20600 EQUIVALENCE (R4,RJQ(2))
11000
11100 20700 CNTR=POS+(2+AMOD(R4,100.)*7)*RSTJ2
11200 JSA 16,AMOD
11300 ARG 02,R4
11400 ARG 02,CONST.
11500 FMPRI 00,203700
11600 FADRI 00,202400
11700 FMPR 00,RSTJ2
11800 FADR 00,POS
11900 MOVEM 00,CNTR
12000
12100 20800 END
12200
12300 JRST 2M
12400 CENTE% ARG 00,0
12500 MOVEM 15,TEMP.
12600 MOVEM 16,TEMP. +1
12700 MOVEI 00,TEMP. +2
12800 PUSH 00,@0(16)
12900 JRST 1M
13000 2M MOVE 15,TEMP.
13100 MOVE 16,TEMP. +1
13200 HRROI 00,TEMP. +3
13300 POP 00,@0(16)
13400 JRA 16,1(16)
13500
13600
13700 CONSTANTS
13800
13900 0 207620000000
14000
14100 GLOBAL DUMMIES
14200
14300 CNTR 30
14400
14500 X.F4 F40 V25 3-MAR-75 17:04 PAGE 4
14600
14700
14800 COMMON
14900
15000 RSTFAC /STF /+0 RSTJ2 /STF /+10 R2 /.COMM./+0 JA /.COMM./+1 CENTR /.COMM./+2
15100 J2 /.COMM./+3 RJQ /.COMM./+4 JQ /.COMM./+30 STF /POSI /+0 JJ2 /POSI /+10
15200 POS /POSI /+11 R4 /.COMM./+5
15300
15400 SUBPROGRAMS
15500
15600 AMOD
15700
15800 SCALARS
15900
16000 CENTER 31 CNTR 30 POS 11 R4 5 RSTJ2 10
16100 R2 0 JA 1 CENTR 2 J2 3 JJ2 10
16200
16300 ARRAYS
16400
16500 RSTFAC 0 RJQ 4 JQ 30 STF 0
16600
16700 X.F4 F40 V25 3-MAR-75 17:04 PAGE 5
16800
16900
17000 20900
17100
17200
17300 21000 SUBROUTINE LINX(A,B,C,D)
17400 1M BLOCK 0
17500
17600 21100 C SAVES SPACE FOR SINGLE LINES.
17700
17800 21200 CALL LINES(A,B,3)
17900 JSA 16,LINES
18000 ARG 02,A
18100 ARG 02,B
18200 ARG 00,CONST.
18300
18400 21300 CALL LINES(C,D,2)
18500 JSA 16,LINES
18600 ARG 02,C
18700 ARG 02,D
18800 ARG 00,CONST.+1
18900
19000 21400 END
19100
19200 JRST 2M
19300 LINX% ARG 00,0
19400 MOVEM 15,TEMP.
19500 MOVEM 16,TEMP. +1
19600 MOVEI 00,TEMP. +2
19700 PUSH 00,@0(16)
19800 PUSH 00,@1(16)
19900 PUSH 00,@2(16)
20000 PUSH 00,@3(16)
20100 JRST 1M
20200 2M MOVE 15,TEMP.
20300 MOVE 16,TEMP. +1
20400 HRROI 00,TEMP. +6
20500 POP 00,@3(16)
20600 POP 00,@2(16)
20700 POP 00,@1(16)
20800 POP 00,@0(16)
20900 JRA 16,4(16)
21000
21100
21200 CONSTANTS
21300
21400 0 000000000003 1 000000000002
21500
21600 GLOBAL DUMMIES
21700
21800 A 37 B 40 C 41 D 42
21900
22000 X.F4 F40 V25 3-MAR-75 17:04 PAGE 6
22100
22200
22300 SUBPROGRAMS
22400
22500 LINES
22600
22700 SCALARS
22800
22900 LINX 43 A 37 B 40 C 41 D 42
23000
23100 X.F4 F40 V25 3-MAR-75 17:04 PAGE 7
23200
23300
23400 21500
23500
23600
23700 21600 SUBROUTINE UNPACK(M,N,I)
23800 1M BLOCK 0
23900
24000 21700 COMMON/LL/L
24100
24200 21800 C L IS FOR VIS. OR INVIS. LINES.
24300
24400 21900 N=I
24500 MOVE 02,I
24600 MOVEM 02,N
24700
24800 22000 L=2
24900 MOVEI 02,2
25000 MOVEM 02,L
25100
25200 22100 M=N/100000000
25300 MOVE 02,N
25400 IDIV 02,CONST.
25500 MOVEM 02,M
25600
25700 22200 IF(M.EQ.0)GO TO 2
25800 MOVE 02,M
25900 JUMPE 02,2P
26000
26100 22300 L=3
26200 MOVEI 02,3
26300 MOVEM 02,L
26400
26500 22400 N=N-100000000*M
26600 MOVE 02,CONST.
26700 IMUL 02,M
26800 SUBM 02,N
26900 MOVNS 00,N
27000
27100 22500 2 M=N/10000
27200 2P MOVE 02,N
27300 IDIVI 02,23420
27400 MOVEM 02,M
27500
27600 22600 N=MOD(N,10000)
27700 JSA 16,MOD
27800 ARG 00,N
27900 ARG 00,CONST.+1
28000 MOVEM 00,N
28100
28200 22700 IF(M.GT.1000)M=1000-M
28300 MOVEI 02,1750
28400 X.F4 F40 V25 3-MAR-75 17:04 PAGE 8
28500
28600
28700 CAML 02,M
28800 JRST 2M
28900 MOVNI 02,1750
29000 ADDM 02,M
29100 MOVNS 00,M
29200 2M BLOCK 0
29300
29400 22800 IF(N.GT.1000)N=1000-N
29500 MOVEI 02,1750
29600 CAML 02,N
29700 JRST 3M
29800 MOVNI 02,1750
29900 ADDM 02,N
30000 MOVNS 00,N
30100 3M BLOCK 0
30200
30300 22900 END
30400
30500 JRST 4M
30600 UNPAC% ARG 00,0
30700 MOVEM 15,TEMP.
30800 MOVEM 16,TEMP. +1
30900 MOVEI 00,TEMP. +2
31000 PUSH 00,@0(16)
31100 PUSH 00,@1(16)
31200 PUSH 00,@2(16)
31300 JRST 1M
31400 4M MOVE 15,TEMP.
31500 MOVE 16,TEMP. +1
31600 HRROI 00,TEMP. +5
31700 SUBI 00,1
31800 POP 00,@1(16)
31900 POP 00,@0(16)
32000 JRA 16,3(16)
32100
32200
32300 CONSTANTS
32400
32500 0 000575360400 1 000000023420
32600
32700 GLOBAL DUMMIES
32800
32900 M 67 N 70 I 71
33000
33100 COMMON
33200
33300 L /LL /+0
33400
33500 SUBPROGRAMS
33600
33700 X.F4 F40 V25 3-MAR-75 17:04 PAGE 9
33800
33900
34000 MOD
34100
34200 SCALARS
34300
34400 UNPACK 72 N 70 I 71 L 0 M 67
34500
34600 X.F4 F40 V25 3-MAR-75 17:04 PAGE 10
34700
34800
34900 23000
35000
35100
35200 23100 FUNCTION ROFF(R)
35300 1M BLOCK 0
35400
35500 23200 S=.5
35600 MOVSI 02,200400
35700 MOVEM 02,S
35800
35900 23300 IF(R)S=-S
36000 MOVE 02,R
36100 JUMPGE 02,2M
36200 MOVNS 00,S
36300 2M BLOCK 0
36400
36500 23400 ROFF=R+S
36600 MOVE 02,S
36700 FADR 02,R
36800 MOVEM 02,ROFF
36900
37000 23500 RETURN
37100 JRST 3M
37200
37300 23600 END
37400
37500 ROFF% ARG 00,0
37600 MOVEM 02,TEMP.
37700 MOVEM 15,TEMP. +1
37800 MOVEM 16,TEMP. +2
37900 MOVEI 00,TEMP. +3
38000 PUSH 00,@0(16)
38100 JRST 1M
38200 3M MOVE 02,TEMP.
38300 MOVE 15,TEMP. +1
38400 MOVE 16,TEMP. +2
38500 MOVE 00,ROFF
38600 JRA 16,1(16)
38700
38800
38900 GLOBAL DUMMIES
39000
39100 R 31
39200
39300 SCALARS
39400
39500 ROFF 32 S 33 R 31
39600